home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0493 / EMSI.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-15  |  7KB  |  297 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 417 of 441
  3. From : Terry Grant                         1:210/20.0           11 Apr 93  08:27
  4. To   : All
  5. Subj :
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Hello All!
  8.  
  9. Here is a unit I posted some time ago for use with EMSI Sessions. Hope it
  10. helps some of you out. You will require a fossil OR Async Interface for
  11. this to compile!
  12. -----------------------------------------------------------------------------}
  13. Program Emsi;
  14.  
  15. Uses
  16.   Dos , Crt, Fossil;
  17.  
  18. Type
  19.   HexString = String[4];
  20.  
  21. Const
  22.   FingerPrint          = '{EMSI}';
  23.   System_Address       = '1:210/20.0';      { Your address }
  24.   Password             = 'PASSWORD';        { Session password }
  25.   Link_Codes           = '{8N1}';           { Modem setup }
  26.   Compatibility_Codes  = '{JAN}';           { Janis }
  27.   Mailer_Product_Code  = '{00}';
  28.   Mailer_Name          = 'MagicMail';
  29.   Mailer_Version       = '1.00';
  30.   Mailer_Serial_Number = '{Alpha}';
  31.   EMSI_INQ : String = '**EMSI_INQC816';
  32.   EMSI_REQ : String = '**EMSI_REQA77E';
  33.   EMSI_ACK : String = '**EMSI_ACKA490';
  34.   EMSI_NAK : String = '**EMSI_NAKEEC3';
  35.   EMSI_CLI : String = '**EMSI_CLIFA8C';
  36.   EMSI_ICI : String = '**EMSI_ICI2D73';
  37.   EMSI_HBT : String = '**EMSI_HBTEAEE';
  38.   EMSI_IRQ : String = '**EMSI_IRQ8E08';
  39.  
  40. Var
  41.   EMSI_DAT : String;            { NOTE : EMSI_DAT has no maximum length }
  42.   Length_EMSI_DAT : HexString;  { Expressed in Hexidecimal }
  43.   Packet : String;
  44.   Rec_EMSI_DAT : String;        { EMSI_DAT sent by the answering system }
  45.   Len_Rec_EMSI_DAT : Word;
  46.  
  47.   Len,
  48.   CRC : HexString;
  49.  
  50.   R : Registers;
  51.   C : Char;
  52.   Loop,ComPort,TimeOut,Tries : Byte;
  53.   Temp : String;
  54.  
  55. Function Up_Case(St : String) : String;
  56. Begin
  57.   For Loop := 1 to Length(St) do
  58.     St[Loop] := Upcase(St[Loop]);
  59.  
  60.   Up_Case := St;
  61. End;
  62.  
  63. function Hex(i : Word) : HexString;
  64. const
  65.   hc : array[0..15] of Char = '0123456789ABCDEF';
  66. var
  67.   l, h : Byte;
  68. begin
  69.   l := Lo(i);
  70.   h := Hi(i);
  71.   Hex[0] := #4;          { Length of String = 4 }
  72.   Hex[1] := hc[h shr 4];
  73.   Hex[2] := hc[h and $F];
  74.   Hex[3] := hc[l shr 4];
  75.   Hex[4] := hc[l and $F];
  76. end {Hex} ;
  77.  
  78. Function Power(Base,E : Byte) : Longint;
  79. Begin
  80.   Power := Round(Exp(E * Ln(Base) ));
  81. End;
  82.  
  83. Function Hex2Dec(HexStr : String) : Longint;
  84.  
  85. Var
  86.   I,HexBit : Byte;
  87.   Temp : Longint;
  88.   Code : integer;
  89.  
  90. Begin
  91.   Temp := 0;
  92.   For I := Length(HexStr) downto 1 do
  93.   Begin
  94.     If HexStr[I] in ['A','a','B','b','C','c','D','d','E','e','F','f'] then
  95.       Val('$' + HexStr[I],HexBit,Code)
  96.         else
  97.           Val(HexStr[I],HexBit,Code);
  98.     Temp := Temp + HexBit * Power(16,Length(HexStr) - I);
  99.   End;
  100.   Hex2Dec := Temp;
  101. End;
  102.  
  103. Function Bin2Dec(BinStr : String) : Longint;
  104.  
  105. { Maximum is 16 bits, though a requirement for more would be   }
  106. { easy to accomodate.  Leading zeroes are not required. There  }
  107. { is no error handling - any non-'1's are taken as being zero. }
  108.  
  109. Var
  110.   I : Byte;
  111.   Temp : Longint;
  112.   BinArray : Array[0..15] of char;
  113.  
  114. Begin
  115.   For I := 0 to 15 do
  116.     BinArray[I] := '0';
  117.   For I := 0 to Pred(Length(BinStr)) do
  118.     BinArray[I] := BinStr[Length(BinStr) - I];
  119.   Temp := 0;
  120.   For I := 0 to 15 do
  121.     If BinArray[I] = '1' then inc(Temp,Round(Exp(I * Ln(2))));
  122.   Bin2Dec := Temp;
  123. End;
  124.  
  125. function CRC16(s:string):word;  { By Kevin Cooney }
  126. var
  127.   crc : longint;
  128.   t,r : byte;
  129. begin
  130.   crc:=0;
  131.   for t:=1 to length(s) do
  132.   begin
  133.     crc:=(crc xor (ord(s[t]) shl 8));
  134.     for r:=1 to 8 do
  135.       if (crc and $8000)>0 then
  136.         crc:=((crc shl 1) xor $1021)
  137.           else
  138.             crc:=(crc shl 1);
  139.   end;
  140.   CRC16:=(crc and $FFFF);
  141. end;
  142.  
  143. {**** FOSSIL Routines ****}
  144. {**** Removed from Code ***}
  145.  
  146. Procedure Hangup;
  147. Begin
  148.     Write2Port('+++'+#13);
  149. End;
  150.  
  151. {**** EMSI Handshake Routines ****}
  152.  
  153. Procedure Create_EMSI_DAT;
  154. Begin
  155.   FillChar(EMSI_DAT,255,' ');
  156.  
  157.   EMSI_DAT := FingerPrint + '{' + System_Address + '}{'+ Password + '}' +
  158.               Link_Codes + Compatibility_Codes + Mailer_Product_Code +
  159.               '{' + Mailer_Name + '}{' + Mailer_Version + '}' +
  160.               Mailer_Serial_Number;
  161.  
  162.   Length_EMSI_DAT := Hex(Length(EMSI_DAT));
  163. End;
  164.  
  165. Function Carrier_Detected : Boolean;
  166. Begin
  167.   TimeOut := 20;   { Wait approximately 20 seconds }
  168.   Repeat
  169.     Delay(1000);
  170.     Dec(TimeOut);
  171.   Until (TimeOut = 0) or (Lo(StatusReq) and $80 = $80);
  172.  
  173.   If Timeout = 0 then
  174.     Carrier_Detected := FALSE
  175.       else
  176.         Carrier_Detected := TRUE;
  177. End;
  178.  
  179. Function Get_EMSI_REQ : Boolean;
  180. Begin
  181.   Temp := '';
  182.   Purge_Input;
  183.  
  184.   Repeat
  185.     C := ReadKeyfromPort;
  186.     If (C <> #10) and (C <> #13) then Temp := Temp + C;
  187.   Until Length(Temp) = Length(EMSI_REQ);
  188.  
  189.   If Up_Case(Temp) = EMSI_REQ then
  190.     get_EMSI_REQ := TRUE
  191.       else
  192.         get_EMSI_REQ := FALSE;
  193. End;
  194.  
  195. Procedure Send_EMSI_DAT;
  196. Begin
  197.   CRC := Hex(CRC16('EMSI_DAT' + Length_EMSI_DAT + EMSI_DAT));
  198.   Write2Port('**EMSI_DAT' + Length_EMSI_DAT + EMSI_DAT + CRC);
  199. End;
  200.  
  201. Function Get_EMSI_ACK : Boolean;
  202. Begin
  203.   Temp := '';
  204.  
  205.   Repeat
  206.     C := ReadKeyfromPort;
  207.     If (C <> #10) and (C <> #13) then Temp := Temp + C;
  208.   Until Length(Temp) = Length(EMSI_ACK);
  209.  
  210.   If Up_Case(Temp) = EMSI_ACK then
  211.     get_EMSI_ACK := TRUE
  212.       else
  213.         get_EMSI_ACK := FALSE;
  214. End;
  215.  
  216. Procedure Get_EMSI_DAT;
  217. Begin
  218.   Temp := '';
  219.   For Loop := 1 to 10 do                  { Read in '**EMSI_DAT' }
  220.     Temp := Temp + ReadKeyfromPort;
  221.  
  222.   Delete(Temp,1,2);                       { Remove the '**'      }
  223.  
  224.   Len := '';
  225.   For Loop := 1 to 4 do                   { Read in the length   }
  226.     Len := Len + ReadKeyFromPort;
  227.  
  228.   Temp := Temp + Len;
  229.  
  230.   Len_Rec_EMSI_DAT := Hex2Dec(Len);
  231.  
  232.   Packet := '';
  233.   For Loop := 1 to Len_Rec_EMSI_DAT do    { Read in the packet   }
  234.     Packet := Packet + ReadKeyfromPort;
  235.  
  236.   Temp := Temp + Packet;
  237.  
  238.   CRC := '';
  239.   For Loop := 1 to 4 do                   { Read in the CRC      }
  240.     CRC := CRC + ReadKeyFromPort;
  241.  
  242.   Rec_EMSI_DAT := Packet;
  243.  
  244.   Writeln('Rec_EMSI_DAT = ',Rec_EMSI_DAT);
  245.  
  246.   If Hex(CRC16(Temp)) <> CRC then
  247.     Writeln('The recieved EMSI_DAT is corrupt!!!!');
  248. End;
  249.  
  250. Begin
  251.   { Assumes connection has been made at this point }
  252.  
  253.   Tries := 0;
  254.   Repeat
  255.     Write2Port(EMSI_INQ);
  256.     Delay(1000);
  257.     Inc(Tries);
  258.   Until (Get_EMSI_REQ = TRUE) or (Tries = 5);
  259.  
  260.   If Tries = 5 then
  261.   Begin
  262.     Writeln('Host system failed to acknowledge the inquiry sequence.');
  263.     Hangup;
  264.     Halt;
  265.   End;
  266.  
  267.   { Used for debugging }
  268.   Writeln('Boss has acknowledged receipt of EMSI_INQ');
  269.  
  270.   Send_EMSI_DAT;
  271.  
  272.   Tries := 0;
  273.   Repeat
  274.     Inc(Tries);
  275.   Until (Get_EMSI_ACK = True) or (Tries = 5);
  276.  
  277.   If Tries = 5 then
  278.   Begin
  279.     Writeln('Host system failed to acknowledge the EMSI_DAT packet.');
  280.     Hangup;
  281.     halt;
  282.   End;
  283.  
  284.   Writeln('Boss has acknowledged receipt of EMSI_DAT');
  285.  
  286.   Get_EMSI_DAT;
  287.   Write2Port(EMSI_ACK);
  288.  
  289.   { Normally the file transfers would start at this point }
  290.   Hangup;
  291. End.
  292.  
  293.  
  294. ---------------------------------------------------------------------------
  295.  This DOES NOT include all the possibilities in an EMSI Session, And JoHo is
  296. Revising most of them right now. When I get further information on the
  297. changes I will repost adding the NEW Features.